package single_linkage_cluster;

require Exporter;

our @ISA = qw(Exporter);
our $VERSION = 1.00;
our @EXPORT = qw(single_linkage_cluster );

use strict;
use warnings;


#
#	expects list of identifiers
#	list of identifier pairs which are linked (only first two fields are retained)
#
sub single_linkage_cluster(\@\@)
{
	my ($ids, $id_links) = @_;
	
	my %ids_to_index;
	my $size = 0;
	for (@$ids)
	{
		$ids_to_index{$_} = $size++;
	}

	my @links;
	for my $link(@$id_links)
	{
		push(@links, [$ids_to_index{$link->[0]}, $ids_to_index{$link->[1]}]);
	}


	my @clusters;
	my %index_to_cluster_id;

	# start with each orthoset in its own cluster
	for (0..($size - 1))
	{
		push(@clusters, [$_]);
		$index_to_cluster_id{$_} = $_;
	}
	

	for my $link_set(@links)
	{
		my ($id0, @other_ids) = @$link_set;

		# this is the cluster where everything will end up
		my $cluster_id0 = $index_to_cluster_id{$id0};
		for my $id(@other_ids)
		{
			my $orig_cluster_id = $index_to_cluster_id{$id};
			next if ($orig_cluster_id == $cluster_id0);

			#
			# merge contents of $orig_cluster_id with $cluster_id0
			#

			# 1. old orthosets should point to cluster_id0
			for my $orig_cluster_member (@{$clusters[$orig_cluster_id]})
			{
				$index_to_cluster_id{$orig_cluster_member} = $cluster_id0;
			}

			# 2. move contents of $orig_cluster_id to $cluster_id0;
			push(@{$clusters[$cluster_id0]}, @{$clusters[$orig_cluster_id]});
			@{$clusters[$orig_cluster_id]} = ();
		}
	}

	# only put non empty clusters into results
	my @non_empty_clusters;
	for (@clusters)
	{
		push(@non_empty_clusters, [map {$ids->[$_]} @$_]) if (@$_ >= 1);
	}
	return @non_empty_clusters;
}


1;
